-- | Branch and Bound with approximations

module ApxBB (T, Bound(..), prepare, trm) where

import qualified Apx
import qualified BB
import qualified Bs
import qualified Iv
import qualified Expr
import Interlude

data T a = Mk
  { pDomain :: [Iv.T a]
  , pExpr   :: Apx.T a
  , pPath   :: [(Int,Hand)]
  , pSubdiv :: Int
  , pBounds :: Iv.T (Maybe a)
  }

newtype Bound a = Bound { unBound :: Maybe a } deriving (Eq,Ord)

instance Show a => Show (Bound a) where
  show = maybe "_|_" show . unBound

prepare :: (Floating a, Ord a) => Int -> String -> Writer String (T a)
prepare v s = do
  when (v>=1) $ tellLn "Non-polynomial mode.\nParsing..."
  seq e $ when (v >= 1) $ tellLn "Bounding..."
  Iv.lo (pBounds b) `seq` return b
  where (x,[Apx.fromExpr -> e]) = justParse (Expr.prob True) s
        b = box x e []

trm :: (Ord a, Num a) => Maybe a -> Iv.T (Bound a) -> Bool
trm (Just eps) (Iv.dest -> (Bound (Just a), Bound (Just b))) = b-a < eps
trm Nothing iv = maybe False (0<) . unBound . Iv.lo $ iv

instance (Floating a, Ord a) => BB.C (T a) where
  type BB.Bound (T a) = Bound a

  bounds = (Bound <$>) . pBounds

  branch (Mk dom e pth k _) = p1 `seq` p2 `seq` [p1,p2] where
    p1 = box dom1 e ((k,L):pth)
    p2 = box dom2 e ((k,R):pth)
    (dom1,dom2) = Iv.subdivBox k dom

box :: (Floating a, Ord a) => [Iv.T a] -> Apx.T a -> [(Int,Hand)] -> T a
box x e pth = k `seq` Mk x e pth k $ Iv.mk (Bs.lo <$> a) (Just $ Apx.eval (map Iv.lo x) e)
  where a = Bs.ofPly <$> Apx.mk (Apx.scale x e) True
        k = maxBy `flip` [0..(length x - 1)] $ \i ->
              uncurry (max `on` abs) . Iv.dest . Bs.lohi . Bs.diff i <$> a

instance Show a => Show (T a) where
  show (Mk _ _ pth _ (Iv.dest -> (a,b))) =
    printf "[%-22s, %-22s] %s" (show a) (show b) $
    concatMap (\(i,h) -> show i ++ map toLower (show h)) $ reverse $ pth
